home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Dylan alpha demos / Online Insultant Pro src ƒ / Menus.dylan < prev    next >
Encoding:
Text File  |  1994-12-13  |  1.7 KB  |  50 lines  |  [TEXT/ttxt]

  1. language: infix-dylan
  2. module: Online-Insultant
  3.  
  4. // This class allows putting up new insults
  5. define class <insulting-behavior> (<behavior>)
  6. end class;
  7.  
  8. define method behavior-setup-menus (behavior :: <insulting-behavior>, 
  9.                                     next :: <list>,
  10.                                     main-handler :: <main-handler>)
  11.                                          => ();
  12.   next-method();
  13.   
  14.   enable-item(#"new");
  15. end method;
  16.  
  17. define method behavior-event (behavior :: <insulting-behavior>, 
  18.                               next :: <list>, 
  19.                               main-handler :: <main-handler>,
  20.                               event :: <menu-event>, 
  21.                               id == #"new")
  22.                                   => ();
  23.   ignore(behavior, next, main-handler, event, id);
  24.   open(make-insult-window());
  25. end method;                   
  26.  
  27. define constant init-Online-Insultant-menus = method()
  28.     make(<menu>,
  29.          title: "File",
  30.          install: #t,
  31.          items: list( make(<menu-item>,
  32.                            title: "New Insult",
  33.                            identifier: #"new",
  34.                            command-key: 'N'),
  35.                       make(<menu-item>,
  36.                            title: "Close",
  37.                            identifier: #"close",
  38.                            command-key: 'W'),
  39.                       make(<menu-item>,
  40.                            title: "Quit",
  41.                            identifier: #"quit",
  42.                            command-key: 'Q')));
  43.  
  44.     install-menu(make-edit-menu());
  45.  
  46.     /*--- to do: About box, Windows menu, English/French menu ---*/
  47.  
  48.     /* Activate the New Insult command */
  49.     add-behavior(*main-handler*, make(<insulting-behavior>));
  50. end method;